perm filename PROGS[1,RWF] blob
sn#536334 filedate 1980-10-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00036 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 PROGRAM LOGTABLE
C00009 00003 PROGRAM BLOCK
C00024 00004 (* CONVERSION FROM FAHRENHEIT TO CELSIUS *)
C00031 00005 (* CONVERSION FROM FAHRENHEIT TO CELSIUS. *)
C00038 00006 (* CONVERSION FROM FAHRENHEIT TO CELSIUS *)
C00040 00007 PROGRAM SUMSQUARES (OUTPUT)
C00041 00008 PROGRAM EXP(INPUT* , OUTPUT )
C00043 00009 PROGRAM TRIANGLE ( OUTPUT )
C00045 00010 (* TRAPEZOID APPROXIMATION TO INTEGRATING THE FUNCTION EXP(-X*X) *)
C00049 00011 (* A PROGRAM TO COMPUTE AND PRINT THE RUNNING BALANCE OF A BANK *)
C00052 00012 (* EVALUATION OF POLYNOMIALS USING HORNER'S RULE. *)
C00057 00013 PROGRAM TOPTWO
C00058 00014 (* `WHAT DOES THIS PROGRAM DRAW? ' EXAMPLE *)
C00062 00015 (* SOLUTION OF A QUADRATIC EQUATION *)
C00066 00016 PROGRAM PAYROLL ( INPUT*, OUTPUT )
C00075 00017 PROGRAM POLY_MULT ( INPUT*, OUTPUT )
C00079 00018 PROGRAM POLY_EXP ( INPUT*, OUTPUT )
C00082 00019 PROGRAM FACTOR ( INPUT*, OUTPUT )
C00083 00020 PROGRAM ROOT_FIND
C00084 00021 PROGRAM MAKE_NEG
C00085 00022 PROGRAM SUM_OF_CUBES ( OUTPUT )
C00087 00023 (* EXAMPLE OF THE USE OF INDEFINITE ITERATION, AND INPUT FROM *)
C00091 00024 (* READING IN A NUMBER IN BASE 7 AND CONVERTING IT TO BASE 10 *)
C00094 00025 (* THIS PROGRAM BEHAVES LIKE A CALCULATOR. IT EVALUATES EXPRESSIONS *)
C00098 00026 (* EXAMPLE IN USE OF LOTS STRING PACKAGE. *)
C00101 00027 (* REMOVING LEADING AND MULTIPLE BLANKS FROM A LINE OF TEXT *)
C00104 00028 (* SEQUENTIAL TABLE LOOKUP IN THE OBVIOUS WAY. *)
C00106 00029 (* SEQUENTIAL TABLE LOOKUP IN A CLEVER WAY *)
C00108 00030 PROGRAM DEMO_PROC ( OUTPUT )
C00109 00031 PROGRAM DEMO_PROC ( INPUT*, OUTPUT )
C00110 00032 PROGRAM DEMO_PROC ( INPUT*, OUTPUT )
C00112 00033 PROGRAM DEMO_PROC ( INPUT*, OUTPUT )
C00113 00034 (* EXAMPLE OF THE USE OF FUNCTIONS *)
C00115 00035 PROGRAM FILLTEXT ( INPUT*, OUTPUT )
C00119 00036 PROGRAM LINE_PAR_FILL ( INPUT*, OUTPUT )
C00123 ENDMK
C⊗;
PROGRAM LOGTABLE;
VAR I,A,C : INTEGER;
BEGIN
FOR I := 1 TO 40 DO WRITE(' ');
WRITE('TABLE OF LOGARITHMS');
WRITELN;
WRITELN;
WRITE(' ');
FOR I:=0 TO 4 DO WRITE(I,' ');
WRITELN;
WRITELN;
FOR A:=2 TO 19 DO
BEGIN
WRITE(5*A);
FOR C:=5*A TO 5*A+4 DO
WRITE(LN(C));
WRITELN
END
END.
************************************************************************
NO INPUT FILE.
************************************************************************
TABLE OF LOGARITHMS
0 1 2 3 4
10 2.302585065 2.397895246 2.484906643 2.564949333 2.639057278
15 2.708050191 2.772588729 2.833213299 2.890371739 2.944438964
20 2.995732218 3.044522374 3.091042429 3.135494202 3.178053826
25 3.218875795 3.258096516 3.295836836 3.332204461 3.367295801
30 3.401197373 3.433987170 3.465735912 3.496507525 3.526360481
35 3.555348038 3.583518922 3.610917896 3.637586146 3.663561612
40 3.688879400 3.713572025 3.737669557 3.761200070 3.784189611
45 3.806662470 3.828641384 3.850147604 3.871201008 3.891820311
50 3.912022978 3.931825608 3.951243698 3.970291882 3.988984018
55 4.007333159 4.025351643 4.043051242 4.060442984 4.077537357
60 4.094344556 4.110873818 4.127134323 4.143134713 4.158883094
65 4.174387216 4.189654707 4.204692602 4.219507634 4.234106481
70 4.248495221 4.262679874 4.276666104 4.290459454 4.304065048
75 4.317488074 4.330733299 4.343805372 4.356708765 4.369447767
80 4.382026553 4.394449114 4.406719207 4.418840527 4.430816709
85 4.442651212 4.454347252 4.465908050 4.477336764 4.488636314
90 4.499809622 4.510859489 4.521788537 4.532599449 4.543294787
95 4.553876876 4.564348161 4.574710965 4.584967494 4.595119833
PROGRAM BLOCK ;
VAR C, L : INTEGER ;
X, Y,
DISTANCE : REAL ;
BEGIN
FOR L:= 1 TO 60 DO (* PRINT L-TH LINE *)
BEGIN
FOR C:=1 TO 132 DO (* PRINT C-TH CHARACTER *)
BEGIN
X := (C-40)/10;
Y := ABS((L-30.5)/6);
(* THE ORIGIN LIES BETWEEN THE 30TH AND 31ST LINES, AT THE
40TH COLUMN *)
IF X > 5 THEN (* REGION B *)
BEGIN
DISTANCE := SQRT((SQR(X-5)+SQR(Y-1.75)));
IF DISTANCE > 2.25 THEN WRITE(' ')
ELSE (* DISTANCE <= 2.25 *)
IF DISTANCE >= 1.25 THEN WRITE('*')
ELSE (* DISTANCE < 1.25 *)
WRITE(' ')
END
ELSE (* REGION A *)
IF Y >= 3 THEN
IF Y > 4 THEN WRITE(' ')
ELSE IF X >= -1 THEN WRITE('*')
ELSE WRITE(' ')
ELSE IF X < 0 THEN WRITE(' ')
ELSE IF X <= 1 THEN WRITE('*')
ELSE IF Y > 0.5 THEN WRITE(' ')
ELSE WRITE('*')
END ;
WRITELN
END
END.
************************************************************************
NO INPUT FILE.
************************************************************************
*******************************************************************
***********************************************************************
**************************************************************************
****************************************************************************
*****************************************************************************
*******************************************************************************
*********** ***************
*********** *************
*********** ***********
*********** ***********
*********** **********
*********** **********
*********** **********
*********** **********
*********** **********
*********** **********
*********** **********
*********** ***********
*********** ***********
*********** *************
*********** ***************
*********************************************************************
*******************************************************************
******************************************************************
******************************************************************
*******************************************************************
*********************************************************************
*********** ***************
*********** *************
*********** ***********
*********** ***********
*********** **********
*********** **********
*********** **********
*********** **********
*********** **********
*********** **********
*********** **********
*********** ***********
*********** ***********
*********** *************
*********** ***************
*******************************************************************************
*****************************************************************************
****************************************************************************
**************************************************************************
***********************************************************************
*******************************************************************
(* CONVERSION FROM FAHRENHEIT TO CELSIUS *)
(* NOTE THAT YOU HAVE TO PUT AN EXTRA SPACE BETWEEN THE TWO COLUMNS TO *)
(* PREVENT THEM FROM RUNNING TOGETHER. *)
PROGRAM TEMP (OUTPUT);
VAR FAHR : INTEGER;
BEGIN
FOR FAHR := - 20 TO 100 DO
WRITELN (FAHR, ' ', (FAHR - 32)*5/9)
END.
************************************************************************
NO INPUT FILE.
************************************************************************
-20 -2.888888895E+01
-19 -2.833333313E+01
-18 -2.777777761E+01
-17 -2.722222238E+01
-16 -2.666666686E+01
-15 -2.611111104E+01
-14 -2.555555552E+01
-13 -2.500000000E+01
-12 -2.444444447E+01
-11 -2.388888895E+01
-10 -2.333333313E+01
-9 -2.277777761E+01
-8 -2.222222238E+01
-7 -2.166666686E+01
-6 -2.111111104E+01
-5 -2.055555552E+01
-4 -2.000000000E+01
-3 -1.944444447E+01
-2 -1.888888880E+01
-1 -1.833333328E+01
0 -1.777777761E+01
1 -1.722222238E+01
2 -1.666666671E+01
3 -1.611111119E+01
4 -1.555555552E+01
5 -1.500000000E+01
6 -1.444444447E+01
7 -1.388888880E+01
8 -1.333333343E+01
9 -1.277777776E+01
10 -1.222222223E+01
11 -1.166666656E+01
12 -1.111111119E+01
13 -1.055555552E+01
14 -1.000000000E+01
15 -9.444444417
16 -8.888888835
17 -8.333333373
18 -7.777777791
19 -7.222222208
20 -6.666666686
21 -6.111111104
22 -5.555555582
23 -5.000000000
24 -4.444444417
25 -3.888888895
26 -3.333333343
27 -2.777777791
28 -2.222222208
29 -1.666666671
30 -1.111111104
31 -5.555555522E-01
32 0.000000000
33 5.555555522E-01
34 1.111111104
35 1.666666671
36 2.222222208
37 2.777777791
38 3.333333343
39 3.888888895
40 4.444444417
41 5.000000000
42 5.555555582
43 6.111111104
44 6.666666686
45 7.222222208
46 7.777777791
47 8.333333373
48 8.888888835
49 9.444444417
50 1.000000000E+01
51 1.055555552E+01
52 1.111111119E+01
53 1.166666656E+01
54 1.222222223E+01
55 1.277777776E+01
56 1.333333343E+01
57 1.388888880E+01
58 1.444444447E+01
59 1.500000000E+01
60 1.555555552E+01
61 1.611111119E+01
62 1.666666671E+01
63 1.722222238E+01
64 1.777777761E+01
65 1.833333328E+01
66 1.888888880E+01
67 1.944444447E+01
68 2.000000000E+01
69 2.055555552E+01
70 2.111111104E+01
71 2.166666686E+01
72 2.222222238E+01
73 2.277777761E+01
74 2.333333313E+01
75 2.388888895E+01
76 2.444444447E+01
77 2.500000000E+01
78 2.555555552E+01
79 2.611111104E+01
80 2.666666686E+01
81 2.722222238E+01
82 2.777777761E+01
83 2.833333313E+01
84 2.888888895E+01
85 2.944444447E+01
86 3.000000000E+01
87 3.055555552E+01
88 3.111111104E+01
89 3.166666686E+01
90 3.222222238E+01
91 3.277777761E+01
92 3.333333343E+01
93 3.388888895E+01
94 3.444444477E+01
95 3.500000000E+01
96 3.555555522E+01
97 3.611111104E+01
98 3.666666656E+01
99 3.722222238E+01
100 3.777777761E+01
(* CONVERSION FROM FAHRENHEIT TO CELSIUS. *)
(* GOING DOWN INSTEAD OF UP. *)
PROGRAM TEMP ( OUTPUT );
VAR FAHR : INTEGER;
BEGIN
FOR FAHR := 100 DOWNTO - 20 DO
WRITELN (FAHR , ' ' , (FAHR - 32)*5/9 )
END.
************************************************************************
NO INPUT FILE.
************************************************************************
100 3.777777761E+01
99 3.722222238E+01
98 3.666666656E+01
97 3.611111104E+01
96 3.555555522E+01
95 3.500000000E+01
94 3.444444477E+01
93 3.388888895E+01
92 3.333333343E+01
91 3.277777761E+01
90 3.222222238E+01
89 3.166666686E+01
88 3.111111104E+01
87 3.055555552E+01
86 3.000000000E+01
85 2.944444447E+01
84 2.888888895E+01
83 2.833333313E+01
82 2.777777761E+01
81 2.722222238E+01
80 2.666666686E+01
79 2.611111104E+01
78 2.555555552E+01
77 2.500000000E+01
76 2.444444447E+01
75 2.388888895E+01
74 2.333333313E+01
73 2.277777761E+01
72 2.222222238E+01
71 2.166666686E+01
70 2.111111104E+01
69 2.055555552E+01
68 2.000000000E+01
67 1.944444447E+01
66 1.888888880E+01
65 1.833333328E+01
64 1.777777761E+01
63 1.722222238E+01
62 1.666666671E+01
61 1.611111119E+01
60 1.555555552E+01
59 1.500000000E+01
58 1.444444447E+01
57 1.388888880E+01
56 1.333333343E+01
55 1.277777776E+01
54 1.222222223E+01
53 1.166666656E+01
52 1.111111119E+01
51 1.055555552E+01
50 1.000000000E+01
49 9.444444417
48 8.888888835
47 8.333333373
46 7.777777791
45 7.222222208
44 6.666666686
43 6.111111104
42 5.555555582
41 5.000000000
40 4.444444417
39 3.888888895
38 3.333333343
37 2.777777791
36 2.222222208
35 1.666666671
34 1.111111104
33 5.555555522E-01
32 0.000000000
31 -5.555555522E-01
30 -1.111111104
29 -1.666666671
28 -2.222222208
27 -2.777777791
26 -3.333333343
25 -3.888888895
24 -4.444444417
23 -5.000000000
22 -5.555555582
21 -6.111111104
20 -6.666666686
19 -7.222222208
18 -7.777777791
17 -8.333333373
16 -8.888888835
15 -9.444444417
14 -1.000000000E+01
13 -1.055555552E+01
12 -1.111111119E+01
11 -1.166666656E+01
10 -1.222222223E+01
9 -1.277777776E+01
8 -1.333333343E+01
7 -1.388888880E+01
6 -1.444444447E+01
5 -1.500000000E+01
4 -1.555555552E+01
3 -1.611111119E+01
2 -1.666666671E+01
1 -1.722222238E+01
0 -1.777777761E+01
-1 -1.833333328E+01
-2 -1.888888880E+01
-3 -1.944444447E+01
-4 -2.000000000E+01
-5 -2.055555552E+01
-6 -2.111111104E+01
-7 -2.166666686E+01
-8 -2.222222238E+01
-9 -2.277777761E+01
-10 -2.333333313E+01
-11 -2.388888895E+01
-12 -2.444444447E+01
-13 -2.500000000E+01
-14 -2.555555552E+01
-15 -2.611111104E+01
-16 -2.666666686E+01
-17 -2.722222238E+01
-18 -2.777777761E+01
-19 -2.833333313E+01
-20 -2.888888895E+01
(* CONVERSION FROM FAHRENHEIT TO CELSIUS *)
(* GOING UP IN STEPS OF 5 INSTEAD OF STEPS OF 1. *)
PROGRAM TEMP (OUTPUT);
VAR FAHR, FOVER5 : INTEGER;
BEGIN
FOR FOVER5 := - 4 TO 20 DO
WRITELN (5*FOVER5, ' ', (5*FOVER5 - 32)*5/9);
END.
************************************************************************
NO INPUT FILE.
************************************************************************
-20 -2.888888895E+01
-15 -2.611111104E+01
-10 -2.333333313E+01
-5 -2.055555552E+01
0 -1.777777761E+01
5 -1.500000000E+01
10 -1.222222223E+01
15 -9.444444417
20 -6.666666686
25 -3.888888895
30 -1.111111104
35 1.666666671
40 4.444444417
45 7.222222208
50 1.000000000E+01
55 1.277777776E+01
60 1.555555552E+01
65 1.833333328E+01
70 2.111111104E+01
75 2.388888895E+01
80 2.666666686E+01
85 2.944444447E+01
90 3.222222238E+01
95 3.500000000E+01
100 3.777777761E+01
PROGRAM SUMSQUARES (OUTPUT);
VAR I, (* ITERATION VARIABLE *)
SUM : INTEGER; (* SUM OF FIRST I PERFECT SQUARES *)
BEGIN
SUM := 0;
FOR I := 1 TO 100 DO
SUM := SUM + SQR(I);
WRITELN ('SUM OF FIRST 100 PERFECT SQUARES : ', SUM)
END.
************************************************************************
NO INPUT FILE.
************************************************************************
SUM OF FIRST 100 PERFECT SQUARES : 338350
PROGRAM EXP(INPUT* , OUTPUT ) ;
VAR I : INTEGER ;
X , (* INPUT VALUE *)
NEXT , (* ONE TERM IN SERIES *)
SUM : REAL ; (* EXP(X) *)
BEGIN
(* INPUT AND INITIALIZATION *)
READ ( X ) ;
SUM := 1.0 ;
NEXT := 1.0 ;
(* SUMMING THE SERIES *)
FOR I := 1 TO 12 DO
BEGIN
NEXT := NEXT*X/I ;
SUM := SUM + NEXT
END ;
(* OUTPUT *)
WRITELN ( ' X = ' , X ) ;
WRITELN ( ' EXP(X) = ' , SUM )
END.
************************************************************************
INPUT FILE:
1.0
************************************************************************
OUTPUT FILE:
X = 1.000000000
EXP(X) = 2.718281775
PROGRAM TRIANGLE ( OUTPUT ) ;
VAR LINE , (* LINENUMBER *)
COLUMN , (* COLUMNNUMBER *)
COUNTER : INTEGER ; (* CURRENT NUMBER TO BE PRINTED *)
BEGIN
(* INITIALIZATION *)
COUNTER := 0 ;
(* PRINT TRIANGLE *)
FOR LINE := 1 TO 10 DO
BEGIN (* PRINT ONE LINE *)
FOR COLUMN := 1 TO LINE DO
BEGIN (* PRINT ONE NUMBER *)
COUNTER := COUNTER + 1 ;
WRITE ( COUNTER:3 )
END ;
WRITELN
END
END.
************************************************************************
NO INPUT FILE.
************************************************************************
1
2 3
4 5 6
7 8 9 10
11 12 13 14 15
16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 32 33 34 35 36
37 38 39 40 41 42 43 44 45
46 47 48 49 50 51 52 53 54 55
(* TRAPEZOID APPROXIMATION TO INTEGRATING THE FUNCTION EXP(-X*X) *)
PROGRAM TRAP (OUTPUT);
VAR APPROXNO, (* TELLS WHICH APPROXIMATION WE'RE WORKING ON *)
NUMTRAPS, (* THE NUMBER OF TRAPEZOIDS USED IN THIS APPROX. *)
T (* KEEPS TRACK OF THE CURRENT TRAPEZOID NUMBER *)
(* WITHIN THIS APPROXIMATION *)
: INTEGER;
AREA, (* RUNNING TOTAL AREA OF ALL TRAPEZOIDS IN APPROX. *)
LASTAREA (* AREA FROM LAST APPROXIMATION *)
: REAL;
BEGIN
WRITELN('NO.':3, 'NUM OF':12, 'APPROXIMATE':18, 'DIFFERENCE':18);
WRITELN(' ':3, 'TRAPEZOIDS':12, 'AREA':18, 'IN AREA':18);
NUMTRAPS:=1; LASTAREA:=0; (* INITIALIZATION *)
FOR APPROXNO:=0 TO 12 DO
BEGIN
(* FIND THE SUM OF THE AREAS OF ALL THE TRAPEZOIDS *)
AREA:=0;
FOR T:=0 TO NUMTRAPS - 1 DO
(* EACH TIME THROUGH THIS LOOP ADDS IN ONE MORE TRAP. *)
AREA:=AREA + (1/NUMTRAPS) * 0.5
*(EXP( - SQR(T/NUMTRAPS)) + EXP( - SQR((T+1)/NUMTRAPS)));
(* PRINT OUT THE ANSWER FOR THIS APPROXIMATION *)
WRITELN(APPROXNO:3, NUMTRAPS:12, ' ':2, AREA, ' ':2, AREA - LASTAREA);
WRITELN(APPROXNO:3, NUMTRAPS:12, ' ':2, AREA, ' ':2, AREA - LASTAREA);
(* SET UP FOR THE NEXT TIME AROUND *)
LASTAREA:=AREA;
NUMTRAPS:=NUMTRAPS*2;
END
END.
************************************************************************
NO INPUT FILE.
************************************************************************
NO. NUM OF APPROXIMATE DIFFERENCE
TRAPEZOIDS AREA IN AREA
0 1 6.839397192E-01 6.839397192E-01
1 2 7.313702583E-01 4.743053793E-02
2 4 7.429841041E-01 1.161384582E-02
3 8 7.458656132E-01 2.881512045E-03
4 16 7.465846002E-01 7.189884781E-04
5 32 7.467642664E-01 1.796633005E-04
6 64 7.468091607E-01 4.489719867E-05
7 128 7.468203663E-01 1.120567321E-05
8 256 7.468231856E-01 2.816319465E-06
9 512 7.468239307E-01 7.450580596E-07
10 1024 7.468240916E-01 1.639127731E-07
11 2048 7.468241393E-01 4.470348358E-08
12 4096 7.468240559E-01 -8.195638656E-08
(* A PROGRAM TO COMPUTE AND PRINT THE RUNNING BALANCE OF A BANK *)
(* ACCOUNT. *)
(* INPUT : THE NUMBER OF CHECKS TO BE ENTERED IN THE BALANCE *)
(* THE INITIAL BALANCE *)
(* THE AMOUNT OF EACH INDIVIDUAL CHECK *)
PROGRAM BALANCE ( INPUT* , OUTPUT ) ;
VAR I,
COUNT : INTEGER ; (* NUMBER OF CHECKS *)
CHECK, (* AMOUNT OF A CHECK *)
BALANCE : REAL ; (* BALANCE OF ACCOUNT *)
BEGIN
(* READ INITIAL DATA *)
READ ( COUNT ) ;
READ (BALANCE ) ;
(* PRINT INITIAL DATA AND HEADER *)
WRITELN (' INITIAL BALANCE :',BALANCE:8:2 ) ;
WRITELN (' NUMBER OF CHECKS :',COUNT:5 ) ;
WRITELN ;
WRITELN (' CHECK NO. AMOUNT BALANCE' ) ;
WRITELN ('---------------------------------' ) ;
(* PROCESS THE CHECKS *)
FOR I := 1 TO COUNT DO
BEGIN
READ ( CHECK ) ;
BALANCE := BALANCE - CHECK ;
WRITELN ( I:10 , CHECK:10:2 , BALANCE:12:2 )
END
END.
************************************************************************
INPUT FILE:
4
234.60
125.00
4.50
61.05
5.00
************************************************************************
OUTPUT FILE:
INITIAL BALANCE : 234.60
NUMBER OF CHECKS : 4
CHECK NO. AMOUNT BALANCE
---------------------------------
1 125.00 109.60
2 4.50 105.09
3 61.05 44.05
4 5.00 39.05
(* EVALUATION OF POLYNOMIALS USING HORNER'S RULE. *)
(* INPUT : FIRST LINE : NUMBER OF POLYNOMIALS TO BE EVALUATED *)
(* NEXT LINES : X DEGREE COEF COEF COEF ... COEF *)
(* X : POINT OF EVALUATION *)
(* DEGREE : DEGREE OF POLYNOMIAL*)
(* COEF : POLYNOMIAL COEFFICIENTS FROM *)
(* HIGH ORDER TO LOW ORDER *)
(* OUTPUT : FACSIMILE OF INPUT , EVALUATED POLYNOMIAL *)
PROGRAM POLY_EVAL ( INPUT* , OUTPUT ) ;
CONST DP = 1 ; (* NUMBER OF DECIMAL PLACES IN OUTPUT *)
VAR NUMBER, (* NUMBER OF POLYNOMIALS *)
DEGREE, (* DEGREE OF POLYNOMIAL *)
I, J : INTEGER ; (* ITERATION VARIABLES *)
X, (* EVALUATION POINT *)
COEF, (* POLYNOMIAL COEFFICIENT*)
VALUE : REAL ; (* (RUNNING) VALUE OF POLYNOMIAL IN X *)
BEGIN
(* READ NUMBER OF LINES *)
READ ( NUMBER ) ;
(* EVALUATE NUMBER POLYNOMIALS *)
FOR I := 1 TO NUMBER DO
BEGIN
(* INITIAL INPUT-OUTPUT AND INITIALIZATION OF VALUE *)
READ ( X, DEGREE ) ;
WRITE ( '( ' ) ;
VALUE := 0.0 ;
(* EVALUATE POLYNOMIAL *)
FOR J := DEGREE DOWNTO 0 DO
BEGIN (* READ/WRITE ONE COEFFICIENT, AND APPLY ONE STEP OF
OF HORNER'S RULE *)
READ ( COEF ) ;
WRITE ( COEF:TRUNC(LOG(ABS(COEF)+1))+3+DP:DP ) ;
IF J <> 0 THEN WRITE ( ' X∧', J:1, ' + ' ) ;
VALUE := VALUE*X + COEF
END ; (*FOR J LOOP *)
(*FINAL OUTPUT *)
WRITELN ( ' ) AT X = ' , X:TRUNC(LOG(ABS(X)+1))+3+DP:DP,
' IS ' , VALUE:TRUNC(LOG(ABS(VALUE)+1))+3+DP:DP )
END (* FOR I LOOP *)
END. (*POLY_EVAL *)
************************************************************************
INPUT FILE:
12
2.3 2 4.0 5.0 6.0
2.3 4 1.2 -3.4 4.5 0.0 6.6
0.0 1 1.0 0.0
999.0 2 0.0 0.0 0.1
0.0 5 1.0 -1.0 1.0 -1.0 1.0 -1.0
200.0 5 1.0 -1.0 1.0 -1.0 1.0 -1.0
2.0 5 1.0 -1.0 1.0 -1.0 1.0 -1.0
1234.5 2 -324.2 5123.8 0.0
0.3 2 3.3 6.6 10.0
284.7 0 -222.9
284.7 1 -222.9 -223.0
284.7 2 -222.9 334.0 -444.9
************************************************************************
OUTPUT FILE:
( 4.0 X2 + 5.0 X1 + 6.0 ) AT X = 2.3 IS 38.6
( 1.2 X4 + -3.4 X3 + 4.5 X2 + 0.0 X1 + 6.6 ) AT X = 2.3 IS 22.6
( 1.0 X1 + 0.0 ) AT X = 0.0 IS 0.0
( 0.0 X2 + 0.0 X1 + 0.1 ) AT X = 999.0 IS 0.1
( 1.0 X5 + -1.0 X4 + 1.0 X3 + -1.0 X2 + 1.0 X1 + -1.0 ) AT X = 0.0 IS -1.0
( 1.0 X5 + -1.0 X4 + 1.0 X3 + -1.0 X2 + 1.0 X1 + -1.0 ) AT X = 200.0 IS 318407961726.1
( 1.0 X5 + -1.0 X4 + 1.0 X3 + -1.0 X2 + 1.0 X1 + -1.0 ) AT X = 2.0 IS 20.9
( -324.2 X2 + 5123.7 X1 + 0.0 ) AT X = 1234.5 IS -487752312.4
( 3.3 X2 + 6.6 X1 + 10.0 ) AT X = 0.3 IS 12.2
( -222.9 ) AT X = 284.7 IS -222.9
( -222.9 X1 + -222.9 ) AT X = 284.7 IS -63682.6
( -222.9 X2 + 334.0 X1 + -444.9 ) AT X = 284.7 IS -17972311.9
PROGRAM TOPTWO ;
VAR I, SCORE, BEST, SECOND, NUMBER, NUMBER1, NUMBER2: INTEGER;
BEGIN
BEST := - 1 ; SECOND := - 1 ;
NUMBER1 := 0 ; NUMBER2 := 0 ;
FOR I := 1 TO 100 DO
BEGIN
READ (NUMBER , SCORE) ;
IF SCORE > SECOND THEN
IF SCORE > BEST THEN
BEGIN
SECOND := BEST ;
BEST := SCORE ;
NUMBER2 := NUMBER1 ;
NUMBER1 := NUMBER ;
END
ELSE
BEGIN
SECOND := SCORE ;
NUMBER2 := NUMBER
END ;
END ;
WRITELN(NUMBER1, BEST, NUMBER2, SECOND)
END.
(* `WHAT DOES THIS PROGRAM DRAW? ' EXAMPLE *)
PROGRAM P ;
VAR S, A, DS, DA, L, C : INTEGER ;
BEGIN
S := 24 ;
A := 1 ;
DS := - 1 ;
DA := 2 ;
FOR L := 0 TO 48 DO
BEGIN
FOR C := 1 TO S DO WRITE(' ') ;
FOR C := 1 TO A DO WRITE('*') ;
WRITELN ;
IF L = 24 THEN
BEGIN
DS := 1 ;
DA := - 2
END ;
S := S + DS ;
A := A + DA
END
END .
************************************************************************
NO INPUT FILE.
************************************************************************
OUTPUT FILE:
*
***
*****
*******
*********
***********
*************
***************
*****************
*******************
*********************
***********************
*************************
***************************
*****************************
*******************************
*********************************
***********************************
*************************************
***************************************
*****************************************
*******************************************
*********************************************
***********************************************
*************************************************
***********************************************
*********************************************
*******************************************
*****************************************
***************************************
*************************************
***********************************
*********************************
*******************************
*****************************
***************************
*************************
***********************
*********************
*******************
*****************
***************
*************
***********
*********
*******
*****
***
*
(* SOLUTION OF A QUADRATIC EQUATION *)
(* 2 *)
(* A X + B X + C = 0 *)
PROGRAM QUAD_EQUATION ( INPUT*, OUTPUT ) ;
VAR A, B, C, (*COEFFICIENTS OF EQUATION*)
DISCR : REAL ; (*DISCRIMINANT OF EQUATION *)
BEGIN
(* INPUT AND INITIAL OUTPUT *)
READ ( A, B, C ) ;
WRITELN (' SOLUTION OF QUADRATIC EQUATION',
A:8:4, ' X∧2 + ', B:8:4, ' X + ', C:8:4, ' = 0.0000 ' ) ;
WRITELN ;
(* SOLUTION OF EQUATION*)
IF A = 0 THEN (* LINEAR EQUATION *)
IF B = 0 THEN (* DEGENERATE EQUATION C = 0 *)
IF C = 0 THEN
WRITELN (' INFINITELY MANY SOLUTIONS' )
ELSE WRITELN (' NO SOLUTIONS' )
ELSE (* REAL LINEAR EQUATION B X + C = 0 *)
WRITELN (' SINGLE SOLUTION :',( - C/B):8:4 )
ELSE (* PROPER QUADRATIC EQUATION *)
BEGIN
DISCR := SQR(B) - 4.0*A*C ;
IF DISCR = 0 THEN
WRITELN (' TWO IDENTICAL SOLUTIONS :',( - B/(2.0*A)):8:4 )
ELSE
IF DISCR > 0 THEN
BEGIN
WRITELN (' TWO REAL SOLUTIONS :',
(( - B - SQRT(DISCR))/(2.0*A)):8:4 );
WRITELN (' ',
(( - B+SQRT(DISCR))/(2.0*A)):8:4 )
END
ELSE
BEGIN
WRITELN (' TWO COMPLEX SOLUTIONS :',
( - B/(2.0*A)):8:4, ' + I ',
(SQRT( - DISCR)/(2.0*A)):8:4 ) ;
WRITELN (' ',
( - B/(2.0*A)):8:4, ' - I ',
(SQRT( - DISCR)/2.0*A):8:4 ) ;
END
END
END.
************************************************************************
INPUT FILE:
2.0 -3.4 -98.4
************************************************************************
OUTPUT FILE:
SOLUTION OF QUADRATIC EQUATION 2.0000 X2 + -3.4000 X + -98.3999 = 0.0000
TWO REAL SOLUTIONS : -6.2155
7.9155
PROGRAM PAYROLL ( INPUT*, OUTPUT ) ;
VAR NUMEMPLOYEE, (* NUMBER OF EMPLOYEES*)
SSNUMBER, (* SOCIAL SECURITY NUMBER*)
NUMEXEM, (* NUMBER OF EXEMPTIONS*)
HEALTHCODE, (* HEALTH INSURANCE CODE*)
I : INTEGER ;
PAYRATE, (* HOURLY PAY RATE*)
HOURS, (* HOURS WORKED*)
GROSSPAY, (* GROSS PAY*)
TAXABLEPAY, (* TAXABLE PAY*)
FEDTAX, (* FEDERAL TAX*)
STATETAX, (* STATE TAX*)
SSTAX, (* SOCIAL SECURITY TAX*)
HEALTHINS, (* HEALTH INSURANCE WITHHOLDING*)
TOTALDEDUCT, (* TOTAL OF DEDUCTIONS*)
NETPAY, (* NET PAY*)
SUMGROSSPAY,SUMFEDTAX, (* SUMS OVER ALL EMPLOYEES/LDOTS*)
SUMSTATETAX,SUMSSTAX,
SUMHEALTHINS,SUMTOTALDEDUCT,
SUMNETPAY : REAL ;
BEGIN
(* READ NUMBER OF EMPLOYEES AND INITIALIZE *)
READ ( NUMEMPLOYEE ) ;
SUMGROSSPAY := 0.0 ;
SUMFEDTAX := 0.0 ;
SUMSTATETAX := 0.0 ;
SUMSSTAX := 0.0 ;
SUMHEALTHINS := 0.0 ;
SUMTOTALDEDUCT := 0.0 ;
SUMNETPAY := 0.0 ;
(* PROCESS EMPLOYEE'S DATA *)
FOR I := 1 TO NUMEMPLOYEE DO
BEGIN
(* READ EMPLOYEE'S DATA *)
READ ( SSNUMBER, PAYRATE, NUMEXEM, HEALTHCODE, HOURS ) ;
(* CHECK DATA FOR VALIDITY *)
IF ( SSNUMBER < 100000000 ) OR
( SSNUMBER > 999999999 ) OR
( PAYRATE < 0.0 ) OR
( NUMEXEM < 0 ) OR
( HEALTHCODE < 1 ) OR
( HEALTHCODE > 3 ) OR
( HOURS < 0.0 )
THEN WRITELN( TTY, 'INVALID DATA ON LINE', I:4 )
ELSE
BEGIN
(* CALCULATE GROSS PAY *)
IF HOURS <= 40.0 THEN
GROSSPAY := HOURS*PAYRATE
ELSE
IF HOURS <= 54.0 THEN
GROSSPAY := 40.0*PAYRATE + (HOURS-40.0)*1.5*PAYRATE
ELSE GROSSPAY := 61.0*PAYRATE ;
(* SUM GROSS PAY *)
SUMGROSSPAY := SUMGROSSPAY + GROSSPAY ;
(* CALCULATE DEDUCTIONS *)
TAXABLEPAY := GROSSPAY-14.0*NUMEXEM-11.0 ;
IF TAXABLEPAY < 0.0 THEN TAXABLEPAY := 0.0 ;
FEDTAX := TAXABLEPAY * ( 0.14 + 2.3E-4 * TAXABLEPAY ) ;
STATETAX := 0.31 * FEDTAX ;
SSTAX := 0.077 * GROSSPAY ;
IF SSTAX > 16.7 THEN SSTAX := 16.7 ;
IF HEALTHCODE = 1 THEN
HEALTHINS := 0.0
ELSE
IF HEALTHCODE = 2 THEN
HEALTHINS := 2.0
ELSE HEALTHINS := 7.5 ;
TOTALDEDUCT := FEDTAX + STATETAX + SSTAX + HEALTHINS ;
(* CHECK IF EARNINGS COVER DEDUCTIONS AND CALCULATE NET PAY *)
(* ALSO SUM THE DEDUCTIONS AND THE NET PAY *)
IF TOTALDEDUCT > GROSSPAY THEN
BEGIN
WRITELN ( TTY, ' EMPLOYEE NUMBER ', SSNUMBER:9 ) ;
WRITELN ( TTY, ' EARNINGS DO NOT COVER WITHHOLDINGS' ) ;
WRITELN ( TTY, ' NO WITHHOLDINGS MADE THIS WEEK.' ) ;
WRITELN ( TTY ) ;
NETPAY := GROSSPAY
END
ELSE
BEGIN
NETPAY := GROSSPAY-TOTALDEDUCT ;
SUMFEDTAX := SUMFEDTAX + FEDTAX ;
SUMSTATETAX := SUMSTATETAX + STATETAX ;
SUMSSTAX := SUMSSTAX + SSTAX ;
SUMHEALTHINS := SUMHEALTHINS + HEALTHINS ;
SUMTOTALDEDUCT := SUMTOTALDEDUCT + TOTALDEDUCT
END;
SUMNETPAY := SUMNETPAY + NETPAY ;
WRITELN ( SSNUMBER :9 , NETPAY :14 :2 )
END (* ELSE CLAUSE *)
END ; (* FOR LOOP *)
(* SEND SUMMARY REPORT TO TERMINAL *)
WRITELN ( TTY, ' SUMMARY REPORT : ' ) ;
WRITELN ( TTY, ' -----------------' ) ;
WRITELN ( TTY, ' TOTAL GROSS PAY' :40, SUMGROSSPAY :20 :2 ) ;
WRITELN ( TTY, ' FEDERAL INCOME TAX DEDUCTIONS' :40, SUMFEDTAX :20 :2 ) ;
WRITELN ( TTY, ' STATE INCOME TAX DEDUCTIONS' :40, SUMSTATETAX :20 :2 ) ;
WRITELN ( TTY, ' SOCIAL SECURITY DEDUCTIONS' :40, SUMSSTAX :20 :2 ) ;
WRITELN ( TTY, ' HEALTH INSURANCE DEDUCTIONS' :40, SUMHEALTHINS :20 :2 ) ;
WRITELN ( TTY, ' TOTAL DEDUCTIONS' :40, SUMTOTALDEDUCT :20 :2 ) ;
WRITELN ( TTY, ' TOTAL NET PAY' :40, SUMNETPAY :20 :2 )
END.
************************************************************************
INPUT FILE:
5
123456789 3.6 0 1 43.0
234567890 4.6 1 2 34.9
345678901 4.8 2 3 32.8
456789012 2.5 1 1 54.9
567890123 4.5 1 2 32.9
************************************************************************
OUTPUT ( PRINTER ) FILE:
123456789 113.79
234567890 115.78
345678901 111.86
456789012 112.47
567890123 107.52
************************************************************************
OUTPUT ( TTY ) FILE:
SUMMARY REPORT :
-----------------
TOTAL GROSS PAY 778.73
FEDERAL INCOME TAX DEDUCTIONS 111.31
STATE INCOME TAX DEDUCTIONS 34.50
SOCIAL SECURITY DEDUCTIONS 59.96
HEALTH INSURANCE DEDUCTIONS 11.50
TOTAL DEDUCTIONS 217.28
TOTAL NET PAY 561.44
PROGRAM POLY_MULT ( INPUT*, OUTPUT ) ;
VAR DEG_A, (* DEGREE OF A *)
DEG_B, (* DEGREE OF B *)
DEG_C, (* DEGREE OF C *)
I, J : INTEGER ;
A : ARRAY[0..10] OF REAL ; (* COEFFICIENTS OF THE *)
B : ARRAY[0..20] OF REAL ; (* INPUT POLYNOMIALS *)
C : ARRAY[0..30] OF REAL ; (* COEFFICIENTS OF THE *)
(* RESULT POLYNOMIAL *)
(* ALL POLYNOMIAL COEFFICIENTS ARE STORED IN *)
(* ASCENDING ORDER, E.G. THE CONSTANT TERM IN *)
(* A[0], B[0],... *)
(* EACH POLYNOMIAL COEFFICIENT IS STORED IN *)
(* ASCENDING ORDER OF THE POWER OF ITS TERM; E.G.*)
(* COEFFICIENT OF CONSTANT TERM IN A[0], B[0], *)
(* COEFFICIENT OF X{$↑$}2 IN A[2], B[2] ETC. *)
BEGIN
(* READ INPUT DATA *)
READ (DEG_A ) ;
FOR I := 0 TO DEG_A DO READ ( A[I] ) ;
READ ( DEG_B ) ;
FOR I := 0 TO DEG_B DO READ ( B[I] ) ;
(* INITIALIZE RESULT *)
FOR I := 0 TO DEG_A + DEG_B DO C[I] := 0.0 ;
(* COMPUTE RESULT COEFFICIENTS *)
FOR I := 0 TO DEG_A DO
FOR J := 0 TO DEG_B DO
C[I+J] := C[I+J] + A[I]*B[J] ;
(* OUTPUT DATA AND RESULT *)
WRITELN ( ' INPUT POLYNOMIALS ' ) ;
WRITELN ( ' ------------------' ) ;
FOR I := 0 TO DEG_A DO WRITELN ( I, A[I] ) ;
WRITELN ;
FOR I := 0 TO DEG_B DO WRITELN ( I, B[I] ) ;
WRITELN ( ' RESULT POLYNOMIAL ' ) ;
WRITELN ( ' ------------------' ) ;
FOR I := 0 TO DEG_A + DEG_B DO WRITELN ( I, C[I] )
END.
************************************************************************
INPUT FILE:
2
1.000000000
2.000000000
1.000000000
3
1.000000000
1.000000000
2.000000000
1.000000000
************************************************************************
OUTPUT FILE:
INPUT POLYNOMIALS
------------------
0 1.000000000
1 2.000000000
2 1.000000000
0 1.000000000
1 1.000000000
2 2.000000000
3 1.000000000
RESULT POLYNOMIAL
------------------
0 1.000000000
1 3.000000000
2 5.000000000
3 6.000000000
4 4.000000000
5 1.000000000
PROGRAM POLY_EXP ( INPUT*, OUTPUT ) ;
VAR DEG_A, (* DEGREE OF A *)
DEG_B, (* B *)
DEG_C, (* C *)
POWER, (* POWER TO WHICH A*)
(* IS TO BE RAISED *)
I, J, K : INTEGER ;
A : ARRAY[0..10] OF REAL ;(* INPUT ARRAY *)
B : ARRAY[0..50] OF REAL ;(* AUXILIARY ARRAY *)
C : ARRAY[0..50] OF REAL ;(* RESULT ARRAY *)
BEGIN
(* READ INPUT DATA *)
READ ( DEG_A ) ;
FOR I := 0 TO DEG_A DO READ ( A[I] ) ;
READ ( POWER ) ;
(* INITIALIZE B TO BE 1.0 *)
DEG_B := 0 ;
B[0] := 1.0 ;
(* RAISE A TO THE POWER `POWER' *)
FOR I := 1 TO POWER DO
BEGIN
DEG_B := ( I - 1 ) * DEG_A ;
DEG_C := DEG_A + DEG_B ;
FOR J := 0 TO DEG_C DO C[J] := 0.0 ;
FOR J := 0 TO DEG_A DO
FOR K := 0 TO DEG_B DO
C[J+K] := C[J+K] + A[J]*B[K] ;
(* NOW C = A * B *)
FOR J := 0 TO DEG_C DO B[J] := C[J]
END ;
(* OUTPUT *)
WRITELN ( ' INPUT POLYNOMIAL ' ) ;
WRITELN ( ' -----------------' ) ;
FOR I := 0 TO DEG_A DO WRITELN ( I:4, A[I]:8:2 ) ;
WRITELN ( ' POWER : ', POWER:4 ) ;
WRITELN ( ' OUTPUT POLYNOMIAL ' ) ;
WRITELN ( ' -----------------' ) ;
FOR I := 0 TO DEG_C DO WRITELN ( I:4, C[I]:8:2 )
END.
************************************************************************
INPUT FILE:
2 1.0 2.0 1.0 3
************************************************************************
INPUT POLYNOMIAL
-----------------
0 1.00
1 2.00
2 1.00
POWER : 3
OUTPUT POLYNOMIAL
-----------------
0 1.00
1 6.00
2 15.00
3 20.00
4 15.00
5 6.00
6 1.00
PROGRAM FACTOR ( INPUT*, OUTPUT ) ;
VAR NUMBER, DIVISOR : INTEGER ;
BEGIN
READ ( NUMBER ) ;
WHILE NOT ODD ( NUMBER ) DO
BEGIN
NUMBER := NUMBER DIV 2 ;
WRITELN (2)
END ;
(* NOW NUMBER IS ODD *)
DIVISOR := 3 ;
(* DIVISOR IS NOW SMALLEST POTENTIAL FACTOR *)
WHILE DIVISOR*DIVISOR <= NUMBER DO
BEGIN
IF NUMBER MOD DIVISOR = 0 THEN
BEGIN
NUMBER := NUMBER DIV DIVISOR ;
WRITELN ( DIVISOR )
END
ELSE DIVISOR := DIVISOR + 2
END;
IF NUMBER > 1 THEN WRITELN ( NUMBER )
END.
PROGRAM ROOT_FIND ;
VAR R, STEP : REAL;
BEGIN
(* FIND FIRST INTEGER R FOR WHICH :
F( R-1 ) > 0, F( R ) <= 0 *)
R := 1.0 ;
WHILE F( R ) > 0.0 DO R := R + 1 ;
STEP := 0.5 ;
WHILE STEP > 0.000001 DO
BEGIN
IF F( R-STEP ) <= 0.0 THEN
R := R-STEP ;
(* ROOT LIES BETWEEN R AND R-STEP *)
STEP := STEP / 2.0
END;
WRITELN ( R-STEP )
END.
PROGRAM MAKE_NEG ;
VAR P, X, STEP : REAL ;
BEGIN
X := 0.0 ;
P := 1.0 ;
WHILE F( X ) >= 0.0 DO
BEGIN
STEP := 1.0 / P ;
X := - P + STEP / 2.0 ;
WHILE ( F(X) >= 0.0 ) AND ( X < P ) DO
X := X + STEP ;
(* EITHER F(X) < 0 NOW, OR WE HAVE LOOKED
FROM - P TO P BY STEPS OF 1/P *)
P := 2.0 * P
END;
(* NOW F(X) < 0 *)
WRITELN ( X )
END.
PROGRAM SUM_OF_CUBES ( OUTPUT ) ;
(* THIS PROGRAM FINDS FOUR INTEGERS: 0 < A < B < C < D
FOR WHICH A*A*A + D*D*D = B*B*B + C*C*C *)
VAR A, B, C, D : INTEGER ;
BEGIN
A := 1 ;
B := 2 ;
C := 3 ;
D := 4 ;
WHILE A*A*A + D*D*D <> B*B*B +C*C*C DO
IF A < B - 1 THEN A := A + 1
ELSE
BEGIN
A := 1 ;
IF B < C - 1 THEN B := B + 1
ELSE
BEGIN
B := 2 ;
IF C < D + 1 THEN C := C + 1
ELSE
BEGIN
C := 3 ;
D := D + 1
END
END
END ;
WRITELN ( A, D, B, C )
END.
************************************************************************
NO INPUT FILE.
************************************************************************
OUTPUT FILE:
1 12 9 10
(* EXAMPLE OF THE USE OF INDEFINITE ITERATION, AND INPUT FROM *)
(* TERMINAL. THIS PROGRAM COMPUTES A SQUARE ROOT WITHOUT *)
(* USING THE STANDARD FUNCTION `SQRT' . *)
(* *)
(****************************************************************)
PROGRAM DEMO_WHILE ;
VAR X, (* VALUE OF WHICH SQUARE ROOT IS TO
BE TAKEN *)
ROOT : REAL ; (* SQUARE ROOT OF X *)
BEGIN (* HEADER AND INPUT *)
WRITELN ( TTY, ' THIS PROGRAM COMPUTES SQUARE ROOTS' ) ;
WRITELN ( TTY, ' WITHOUT USING THE BUILT-IN FUNCTION' ) ;
WRITE ( TTY, ' INPUT NUMBER : ' ) ;
BREAK ( TTY ) ;
READ ( TTY, X ) ;
(* INPUT VALIDATION *)
WHILE X < 0.0 DO
BEGIN
WRITELN ( TTY, ' NEGATIVE NUMBERS NOT ALLOWED ' ) ;
WRITE ( TTY, ' TRY AGAIN : ' ) ;
BREAK ( TTY ) ;
READ ( TTY, X )
END ;
(* INITIALIZATION *)
ROOT := 1.0 ;
(* COMPUTATION OF SQUARE ROOT *)
WHILE ABS( (ROOT - X/ROOT) ) > 1.0E-6 DO
ROOT := 0.5 * ( ROOT + X/ROOT ) ;
(* OUTPUT *)
WRITE ( TTY, ' SQUARE ROOT OF ', X :8 :4, ' IS ', ROOT :10 :6 )
END.
************************************************************************
INPUT FILE ( TTY ) :
10.0
************************************************************************
OUTPUT FILE ( TTY ) :
THIS PROGRAM COMPUTES SQUARE ROOTS
WITHOUT USING THE BUILT-IN FUNCTION
INPUT NUMBER : SQUARE ROOT OF 10.0000 IS 3.162277
************************************************************************
INPUT FILE ( TTY ) :
-2.0 2.0
************************************************************************
OUTPUT FILE ( TTY ) :
THIS PROGRAM COMPUTES SQUARE ROOTS
WITHOUT USING THE BUILT-IN FUNCTION
INPUT NUMBER : NEGATIVE NUMBERS NOT ALLOWED
TRY AGAIN : SQUARE ROOT OF 2.0000 IS 1.414213
(* READING IN A NUMBER IN BASE 7 AND CONVERTING IT TO BASE 10 *)
(* *)
(* THIS PROGRAM HAS SOME SUBTLE POINTS TO IT: *)
(* *)
(* 1. THE PARENTHESIS AROUND " ORD(C) - ORD(0) " TO *)
(* PREVENT INTEGER OVERFLOW. *)
(* *)
(* 2. WHEN YOU TRY TO READ A CHARACTER AT THE END OF THE *)
(* END OF A LINE, YOU GET A SPACE. THIS IS THE REASON *)
(* WHY THE PROGRAM ALWAYS STOPS AT THE END OF A LINE. *)
(* *)
(****************************************************************)
PROGRAM CONVERT ( INPUT*, OUTPUT ) ;
VAR C : CHAR ; (* CHARACTER LAST READ IN. *)
VALUE : INTEGER ; (* VALUE IN BASE 10. *)
BEGIN
C := ' ' ;
WHILE ( C< '0' ) OR ( C> '6' ) DO READ ( C ) ;
VALUE := ORD ( C ) - ORD ( '0' ) ;
READ ( C ) ;
WHILE ( C >= '0' ) AND ( C <= '6' ) DO
BEGIN
VALUE := VALUE*7 + ( ORD (C) - ORD ('0') ) ;
READ ( C )
END;
WRITELN ( ' DECIMAL VALUE = ', VALUE :8 )
END.
************************************************************************
INPUT FILE:
46
************************************************************************
OUTPUT FILE:
DECIMAL VALUE = 34
************************************************************************
INPUT FILE:
///// 23 //////
************************************************************************
OUTPUT FILE:
DECIMAL VALUE = 17
(* THIS PROGRAM BEHAVES LIKE A CALCULATOR. IT EVALUATES EXPRESSIONS *)
(* CONTAINING THE OPERATORS +, -, *, / STRICTLY FROM LEFT TO RIGHT.*)
(* NO PARENTHESES OR BLANKS ARE ALLOWED WITHIN THE EXPRESSION. *)
(* THE EXPRESSION IS TERMINATED BY AN EQUAL SIGN ( = ) . *)
(* *)
(*********************************************************************)
PROGRAM CALCULATOR ( INPUT*, OUTPUT ) ;
VAR EXP, (* CURRENT VALUE OF EXPRESSION *)
NEW : REAL ; (* HOLDS VALUE LAST READ IN *)
UNDEF, (* FLAGS AN UNDEFINED OPERATOR *)
NOTDONE : BOOLEAN ; (* FLAG SIGNALLING END OF EXPRESSION *)
C : CHAR ; (* OPERATOR *)
BEGIN
READ ( EXP ) ;
UNDEF := FALSE ;
NOTDONE := TRUE ;
WHILE NOTDONE DO
BEGIN
READ ( C );
IF C <> '=' THEN
BEGIN
READ ( NEW ) ;
IF C = '+' THEN EXP := EXP + NEW
ELSE
IF C = '-' THEN EXP := EXP - NEW
ELSE
IF C = '*' THEN EXP := EXP * NEW
ELSE
IF C = '/' THEN EXP := EXP / NEW
ELSE
BEGIN
NOTDONE := FALSE ;
UNDEF := TRUE ;
WRITELN ( ' UNDEFINED OPERATOR' )
END
END
ELSE NOTDONE := FALSE
END ;
IF NOT UNDEF THEN WRITE ( EXP :8 :4 )
END.
************************************************************************
INPUT FILE:
3.0+5.0*4.5-3.0/11.0=
************************************************************************
OUTPUT FILE:
3.0000
************************************************************************
INPUT FILE:
3.0↑5.0=
************************************************************************
OUTPUT FILE:
UNDEFINED OPERATOR
(* EXAMPLE IN USE OF LOTS STRING PACKAGE. *)
(* THIS PROGRAM TRANSLATES AN ENGLISH WORD INTO PIG-LATIN *)
(* *)
(****************************************************************)
PROGRAM PIGLATIN ( INPUT*, OUTPUT ) ;
VAR I : INTEGER ;
SOURCE,
TARGET : STRING ;
FUNCTION VOWEL ( LETTER : CHAR ) : BOOLEAN ;
BEGIN
VOWEL := ( LETTER = 'A' )
OR ( LETTER = 'E' )
OR ( LETTER = 'I' )
OR ( LETTER = 'O' )
OR ( LETTER = 'U' )
END ; (* VOWEL *)
BEGIN
(* READ INPUT *)
READ ( SOURCE ) ;
(* CHECK THE FIRST CHARACTER *)
IF VOWEL ( GETCHAR(SOURCE, 1) ) THEN
BEGIN (* FIRST CHARACTER IS A VOWEL *)
ASSIGN ( SOURCE, TARGET ) ;
CONCAT ( 'WAY', TARGET )
END
ELSE
BEGIN (* FIRST CHARACTER IS NOT A VOWEL *)
(* INITIALIZE TARGET *)
ASSIGN ( NULLSTR, TARGET );
(* LOOK FOR FIRST VOWEL *)
I := 2 ;
WHILE NOT VOWEL ( GETCHAR(SOURCE, I) ) DO I := I + 1 ;
(* TRANSLATE *)
SUBSTR ( SOURCE, TARGET, I, 1, LENGTH(SOURCE) + 1 - I ) ;
SUBSTR ( SOURCE, TARGET, 1, LENGTH(SOURCE) + 2 - I, I - 1 ) ;
CONCAT ( 'AY', TARGET )
END ;
(* OUTPUT *)
WRITELN ( ' INPUT : ', SOURCE ) ;
WRITELN ( ' OUTPUT: ', TARGET )
END.
************************************************************************
INPUT:
AMERICA
************************************************************************
OUTPUT FILE:
INPUT : AMERICA
OUTPUT: AMERICAWAY
************************************************************************
INPUT FILE:
STANFORD
************************************************************************
OUTPUT FILE:
INPUT : STANFORD
OUTPUT: ANFORDSTAY
(* REMOVING LEADING AND MULTIPLE BLANKS FROM A LINE OF TEXT *)
(* *)
(****************************************************************)
PROGRAM KILL_BLANKS ( INPUT*, OUTPUT ) ;
CONST TAB_SIZE = 60 ;
VAR I, J, K : INTEGER ;
SOURCE,
TARGET : ARRAY[0..TAB_SIZE] OF CHAR ;
(* INPUT AND OUTPUT LINES OF TEXT *)
BEGIN
(* READ INPUT LINE *)
FOR I := 1 TO TAB_SIZE DO READ ( SOURCE[I] ) ;
(* INITIALIZE *)
SOURCE[0] := ' ' ;
I := 1 ;
J := 1 ;
WHILE I <= TAB_SIZE DO
BEGIN
IF ( SOURCE[ I-1 ] <> ' ' ) OR ( SOURCE[ I ] <> ' ' ) THEN
BEGIN
TARGET[J] := SOURCE[I] ;
J := J + 1
END ;
I := I + 1
END;
FOR K := J TO TAB_SIZE DO TARGET[K] := ' ' ;
(* OUTPUT *)
FOR K := 1 TO TAB_SIZE DO WRITE ( SOURCE[K] ) ;
WRITELN ;
FOR K := 1 TO TAB_SIZE DO WRITE ( TARGET[K] )
END.
************************************************************************
INPUT FILE:
DRAGONRIDERS MUST FLY WHEN THREADS ARE IN THE SKY
************************************************************************
OUTPUT FILE:
DRAGONRIDERS MUST FLY WHEN THREADS ARE IN THE SKY
DRAGONRIDERS MUST FLY WHEN THREADS ARE IN THE SKY
(* SEQUENTIAL TABLE LOOKUP IN THE OBVIOUS WAY. *)
(* *)
(****************************************************************)
PROGRAM LOOKUP ( INPUT*, OUTPUT ) ;
VAR SEARCH_NUM ,
I : INTEGER ;
TABLE : ARRAY[1..11] OF INTEGER ;
(* NOTE THAT WE MUST DECLARE THE ARRAY SIZE ONE *)
(* BIGGER THAN THE TABLE SIZE TO PREVENT THE INDEX *)
(* FROM GOING OUT OF BOUNDS WHEN THE NUMBER WE'RE *)
(* LOOKING FOR IS NOT FOUND. *)
BEGIN
FOR I := 1 TO 10 DO READ ( TABLE[I] ) ;
READ ( SEARCH_NUM ) ;
I := 1 ;
WHILE ( TABLE[I] <> SEARCH_NUM ) AND ( I <= 10 ) DO I := I + 1 ;
IF I <= 10 THEN WRITELN ( SEARCH_NUM :4, ' FOUND AT POSITION', I :4 )
ELSE WRITELN ( SEARCH_NUM :4, ' NOT FOUND' )
END.
(* SEQUENTIAL TABLE LOOKUP IN A CLEVER WAY *)
(* *)
(****************************************************************)
PROGRAM LOOKUP ( INPUT*, OUTPUT ) ;
VAR SEARCH_NUM,
I : INTEGER ;
TABLE : ARRAY[1..11] OF INTEGER ;
(* NOTE THAT WE MUST DECLARE THE ARRAY SIZE ONE *)
(* BIGGER THAN THE TABLE SIZE TO PREVENT THE INDEX *)
(* FROM GOING OUT OF BOUNDS WHEN THE NUMBER WE'RE *)
(* LOOKING FOR IS NOT FOUND. *)
BEGIN
FOR I := 1 TO 10 DO READ ( TABLE[I] ) ;
READ ( SEARCH_NUM ) ;
I := 1 ;
TABLE[11] := SEARCH_NUM ; (* GUARANTEES FINDING THE NUMBER IN ARRAY *)
WHILE ( TABLE[I] <> SEARCH_NUM ) DO I := I + 1 ;
IF I <= 10 THEN WRITELN ( SEARCH_NUM :4, ' FOUND AT POSITION', I :4 )
ELSE WRITELN ( SEARCH_NUM :4, ' NOT FOUND' )
END.
PROGRAM DEMO_PROC ( OUTPUT ) ;
PROCEDURE WRITE_STARS ;
VAR I : INTEGER ;
BEGIN
FOR I := 1 TO 12 DO WRITE ( '*' ) ;
WRITELN
END ; (* WRITE_STARS *)
BEGIN (* MAIN *)
WRITE_STARS ;
WRITELN ( SQRT(2.0) ) ;
WRITE_STARS
END. (* MAIN *)
************************************************************************
NO INPUT FILE.
************************************************************************
OUTPUT FILE:
************
1.414213567
************
PROGRAM DEMO_PROC ( INPUT*, OUTPUT ) ;
VAR N : INTEGER ;
PROCEDURE WRITESTARS ;
VAR I : INTEGER ;
BEGIN
FOR I := 1 TO N DO WRITE ( '*' ) ;
N := N + 2 ;
WRITELN
END ; (* WRITESTARS *)
BEGIN (* MAIN *)
READ ( N ) ;
WRITESTARS ;
WRITELN ( SQRT(2.0) ) ;
WRITESTARS
END. (* MAIN *)
************************************************************************
INPUT FILE:
12
************************************************************************
OUTPUT FILE:
************
1.414213567
**************
PROGRAM DEMO_PROC ( INPUT*, OUTPUT ) ;
VAR N : INTEGER ;
PROCEDURE WRITESTARS ( K : INTEGER ) ;
VAR I : INTEGER ;
BEGIN
FOR I := 1 TO K DO WRITE ( '*' ) ;
K := K + 2 ; (* THIS STATEMENT IS TOTALLY USELESS AND IS *)
(* ONLY INSERTED FOR DEMONSTRATION PURPOSES *)
WRITELN
END ; (* WRITESTARS *)
BEGIN (* MAIN *)
READ ( N ) ;
WRITESTARS ( N ) ;
WRITELN ( SQRT(2.0) ) ;
WRITESTARS ( N )
END. (* MAIN *)
************************************************************************
INPUT FILE:
12
************************************************************************
OUTPUT FILE:
************
1.414213567
************
PROGRAM DEMO_PROC ( INPUT*, OUTPUT ) ;
VAR N : INTEGER ;
PROCEDURE WRITESTARS ( VAR K : INTEGER ) ;
VAR I : INTEGER ;
BEGIN
FOR I := 1 TO K DO WRITE ( '*' ) ;
K := K + 2 ;
WRITELN
END ; (* WRITESTARS *)
BEGIN (* MAIN *)
READ ( N ) ;
WRITESTARS ( N ) ;
WRITELN ( SQRT(2.0) ) ;
WRITESTARS ( N )
END. (* MAIN *)
************************************************************************
INPUT FILE:
12
************************************************************************
OUTPUT FILE:
************
1.414213567
**************
(* EXAMPLE OF THE USE OF FUNCTIONS *)
(* *)
(**********************************************************************)
PROGRAM DEMO_FUNC ( INPUT*, OUTPUT ) ;
VAR X, Y : REAL ;
FUNCTION HYPOT ( X, Y : REAL ) : REAL ;
(* COMPUTES HYPOTENUSE OF THE RIGHT TRIANGLE WHOSE SIDES ARE X AND Y *)
BEGIN
HYPOT := SQRT ( SQR(X) + SQR(Y) )
END ; (* HYPOT *)
FUNCTION LENGTH ( X : REAL ; DP : INTEGER ) : INTEGER ;
(* COMPUTES THE FIELD-LENGTH NECESSARY TO OUTPUT X
WITH DP DECIMAL PLACES *)
BEGIN
LENGTH := TRUNC ( LOG( ABS(X) ) ) + 3 + DP
END ; (* LENGTH *)
BEGIN (* MAIN *)
READ ( X, Y ) ;
WRITELN ( ' X = ', X: LENGTH(X,2) :2 ) ;
WRITELN ( ' Y = ', Y: LENGTH(Y,2) :2 ) ;
WRITELN ( ' HYPOT(X,Y) = ', HYPOT(X,Y) :LENGTH( HYPOT(X,Y), 2) :2 )
END.
************************************************************************
INPUT FILE:
3.0 4.0
************************************************************************
OUTPUT FILE:
X = 3.00
Y = 4.00
HYPOT(X,Y) = 5.00
PROGRAM FILLTEXT ( INPUT*, OUTPUT ) ;
VAR WORDSIZE, LINESIZE,
I, MAXLINE : INTEGER ;
WORD : ARRAY[1..100] OF CHAR ;
C : CHAR;
BEGIN
MAXLINE := 30 ;
WORDSIZE := 0 ;
LINESIZE := 0 ;
WHILE NOT EOF DO
BEGIN (* A *)
READ ( C ) ;
IF C = ' ' THEN
BEGIN (* B *)
IF WORDSIZE > 0 THEN
BEGIN (* C *) (* END OF WORD *)
IF ( LINESIZE > 0 ) AND ( LINESIZE + WORDSIZE + 1 > MAXLINE )
OR ( WORDSIZE > MAXLINE ) THEN
BEGIN (* D *) (* FINISH LINE *)
WRITELN ;
LINESIZE := 0
END (* D *) ;
IF ( LINESIZE > 0 ) THEN
BEGIN (* E *)
WRITE ( ' ' ) ;
LINESIZE := LINESIZE + 1
END (* E *) ;
FOR I := 1 TO WORDSIZE DO WRITE ( WORD[I] ) ;
LINESIZE := LINESIZE + WORDSIZE ;
WORDSIZE := 0
END (* C *)
END (* B *)
ELSE (* NON-BLANK *)
BEGIN (* F *)
WORDSIZE := WORDSIZE + 1 ;
WORD[ WORDSIZE ] := C
END (* F *)
END (* A *) ;
(* END OF FILE *)
WRITELN
END .
************************************************************************
INPUT FILE:
WE WANT TO DESIGN A PROGRAM
WHICH WILL READ ENGLISH TEXT FROM A FILE AND PRINT IT OUT IN A SPECIFIED
WIDTH, PACKING AS MANY WORDS
AS POSSIBLE INTO A LINE, AND PRINTING THE WORDS AS FAR TO THE
LEFT AS POSSIBLE.
************************************************************************
OUTPUT FILE:
WE WANT TO DESIGN A PROGRAM
WHICH WILL READ ENGLISH TEXT
FROM A FILE AND PRINT IT OUT
IN A SPECIFIED WIDTH, PACKING
AS MANY WORDS AS POSSIBLE INTO
A LINE, AND PRINTING THE WORDS
AS FAR TO THE LEFT AS
POSSIBLE.
P23E2
PROGRAM LINE_PAR_FILL ( INPUT*, OUTPUT ) ;
VAR WORDSIZE, LINESIZE,
I, MAXLINE : INTEGER ;
WORD : ARRAY[1..100] OF CHAR ;
C : CHAR;
NEWLINE, NEWPAR, ENDOFLINE : BOOLEAN ;
BEGIN
(* INITIALIZE *)
MAXLINE := 30 ;
WORDSIZE := 0 ;
LINESIZE := 0 ;
ENDOFLINE := TRUE ;
NEWPAR := TRUE ;
WHILE NOT EOF DO
BEGIN (* A *)
NEWLINE := ENDOFLINE ;
ENDOFLINE := EOLN ( INPUT ) ;
READ ( C ) ;
IF C = ' ' THEN
BEGIN (* B *)
IF NEWLINE THEN
BEGIN (* C *)
NEWPAR := TRUE ;
IF LINESIZE > 0 THEN
BEGIN (* D *)
WRITELN ;
LINESIZE := 0
END (* D *)
END (* C *) ;
IF WORDSIZE > 0 THEN
BEGIN (* D *) (* END OF WORD *)
IF (( LINESIZE > 0 ) AND ( LINESIZE + WORDSIZE + 1 > MAXLINE ))
OR ( WORDSIZE > MAXLINE ) THEN
BEGIN (* E *) (* FINISH LINE *)
WRITELN ;
LINESIZE := 0
END (* E*) ;
IF LINESIZE > 0 THEN
BEGIN (* F *) (* INTERWORD SPACE *)
WRITE ( ' ' ) ;
LINESIZE := LINESIZE + 1
END (* F *) ;
IF NEWPAR THEN
BEGIN (* G *)
WRITE ( ' ' ) ;
LINESIZE := 3 ;
NEWPAR := FALSE
END (* G *) ;
FOR I := 1 TO WORDSIZE DO WRITE ( WORD[I] ) ;
LINESIZE := LINESIZE + WORDSIZE ;
WORDSIZE := 0
END (* D *)
END (* B *)
ELSE (* NONBLANK *)
BEGIN (* H *)
WORDSIZE := WORDSIZE + 1 ;
WORD[ WORDSIZE ] := C
END (* H *)
END (* A *) (* WHILE *) ;
(* END OF FILE *)
IF LINESIZE > 0 THEN WRITELN
END .
************************************************************************
INPUT FILE
THIS IS A PARAGRAPH.
THIS IS A NEW PARAGRAPH.
THIS IS ANOTHER NEW PARAGRAPH, AS YOU CAN EASILY SEE.
BUT THIS IS NOT A NEW PARAGRAPH AT ALL.
************************************************************************
OUTPUT FILE
THIS IS A PARAGRAPH.
THIS IS A NEW PARAGRAPH.
THIS IS ANOTHER NEW
PARAGRAPH, AS YOU CAN EASILY
SEE. BUT THIS IS NOT A NEW
PARAGRAPH AT ALL.